home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 4
/
Apprentice-Release4.iso
/
Languages
/
Mops 2.7
/
Mops source
/
Asm Source
/
ic1
< prev
next >
Wrap
Text File
|
1994-05-08
|
8KB
|
447 lines
\ Instruction Classes Reese Warner 3/85
\ 8/85 RW added comments
\ 8/85 RW Added Neon mode
\ 9/85 RW Added type 26, sized single ea instruction
\ 9/85 RW Added type27, for the STOP instruction
\ 12/85 JF fixed LENGTH: method on TYPE3
\ 03/07/86 GDC fixed type 7 BUILD:
\ 2-Oct-86 MRH fixed type4 BUILD:
\ 11-May-87 MRH added range checking for immediates, shifts, ADDQ, SUBQ
\ 9-Aug-87 MRH fixed type9 BUILD:
0 -> dlevel
:CLASS machInst super( object )
record
{ var bytecode
int srcMask
int dstMask
int theSize
}
:M INIT: { opcode -- }
opcode put: bytecode
hex
intrp1 put: srcMask \ reads sourcemask
intrp1 put: dstMask \ reads destination mask
intrp1 put: theSize \ reads the default machine code size
decimal
;M
:M BC: \ debug
hex get: bytecode ." bytecode is " u. cr decimal
;M
:M MASKS: \ debug
hex get: srcMask ." src is " u. cr
get: dstMask ." dst is " u. cr decimal
;M
:M OPFMT:
get: theSize
;M
:m PRINT:
." class is " .class: self cr
bc: self masks: self
." size is " get: theSize . cr ;m
;CLASS
\ TYPE1 - No operand instructions, such as Reset.
:CLASS type1 super( machinst )
:M BUILD:
get: bytecode w,
;M
:M LENGTH: ( -- len )
1
;M
;CLASS
\ TYPE2 - Register, immediate value, such as Link
\ e.g. Link A0,#100
:CLASS type2 super( machinst )
:M BUILD: { \ workSpace -- }
op1 getOp
get: bytecode -> workSpace
workSpace reg: op1 or w,
op2 getOp
value: op2 w,
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
2
;M
;CLASS
\ TYPE3 - Instructions that take an immediate operand, such as ANDI, EORI
\ e.g. EORI.W #100,-(A4)
:CLASS type3 super( machinst )
:M BUILD: { \ workSpace -- }
op1 getOp
op2 getOp
get: bytecode -> workSpace
opFmt 6 << workSpace or -> workSpace
ea: op2 workspace or -> workSpace
workSpace w,
value: op1 \ immediate Data
opFmt
CASE
0 OF 249 byteChk w, ENDOF
1 OF 249 wordChk w, ENDOF
( 2, presumably ) drop , 0
ENDCASE
op2 compIdxMode
;M
:M LENGTH: { \ size -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
2 -> size
op2 modeSize ++> size
opFmt 1- 0 max ++> size \ '1 max' -> '1- 0 max' jaf 12/17
size
;M
;CLASS
\ TYPE4 - Instructions that take a reg, an effective Addr, an opmode
\ e.g. OR.L D0,(SP)
:CLASS type4 super( machinst )
:M BUILD: { \ opMode Reg EA workSpace flag -- }
op1 getOp op2 getOp
true -> flag
mode: op2 1 =
IF
opFmt 2 =
IF
7 -> opMode
ELSE
3 -> opMode
THEN
reg: op2 -> reg
ea: op1 -> ea
false -> flag
THEN
mode: op2 0= flag and
get: srcMask 1 <> and \ Don't let EOR Dm,Dn come here - MRH
IF
opFmt -> opMode
reg: op2 -> reg
ea: op1 -> ea
false -> flag
THEN
mode: op1 0= flag and
IF
opFmt 4+ -> opMode
reg: op1 -> reg
ea: op2 -> ea
false -> flag
THEN
flag
IF
219 asmERROR \ at least one operand must be a register direct
THEN
get: bytecode -> workSpace
reg 9 << workSpace or -> workspace
opMode 6 << workSpace or -> workSpace
ea workSpace or -> workSpace
workSpace w,
op1 compIdxMode
op2 compIdxMode
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1 -> len
op1 modesize ++> len
op2 modesize ++> len
len
;M
;CLASS
\ TYPE5 - reg & ea, unsized e.g. LEA <ea>,A3
:CLASS type5 super( machinst )
:M BUILD: { \ workSpace -- }
op1 getOp
op2 getOp
get: bytecode -> workSpace
reg: op2 9 << workSpace or -> workSpace
ea: op1 workSpace or -> workSpace
workSpace w,
op1 compIdxMode
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1 op1 modeSize +
;M
;CLASS
\ TYPE6 - Branch instructions - Bcc, BRA, BSR
:CLASS type6 super( machinst )
:M BUILD:
op1 getOp get: bytecode
op1 abs: operand dup NIF 245 asmError THEN \ wrong mode
here 2+ -
opFmt Sfmt =
IF 250 byteChk $ FF and or w,
ELSE swap w, 250 wordChk w,
THEN
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
opFmt Sfmt = IF 1 ELSE 2 THEN
;M
;CLASS
\ TYPE7 - Bit test operations: BCLR,BSET,BTST,BCHG
\ e.g. BTST D5,-(A4) or BTST #5,-(A4)
:CLASS type7 super( machinst )
:M BUILD: { \ workSpace -- }
op1 getOp
op2 getOp
get: bytecode -> workSpace
mode: op1 0=
IF
reg: op1 9 << workSPace or -> workSpace
ea: op2 workSpace or -> workSpace
256 workspace or -> workspace
workSpace w,
ELSE
ea: op2 workSpace or -> workSpace
2048 workspace or -> workSpace
workSpace w,
value: op1 w,
THEN
op2 compIdxMode
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
mode: op1 0=
IF
1 -> len
ELSE
2 -> len
THEN
len
;M
;CLASS
\ TYPE8 - single ea instructions. E.G. PEA aLabel
:CLASS type8 super( machinst )
:M BUILD:
op1 getOp
get: bytecode ea: op1 or w,
op1 compIdxMode
;M
:M LENGTH: { \ len - len }
op1 getOp
op1 get: srcMask check
1 -> len
op1 modeSize ++> len
len
;M
;CLASS
\ TYPE9 - EXG A2,D4
:CLASS type9 super( machinst )
:M BUILD:
op1 getOp
op2 getOp
reg: op2 reg: op1
mode: op1 0= mode: op2 0= and
IF \ Both D regs
$ 40
ELSE
mode: op1 mode: op2 and
IF \ Both A regs
$ 48
ELSE \ One D, one A
mode: op1
IF ( A is first, but needs to be second )
swap
THEN
$ 88
THEN
THEN
swap 9 << or or get: bytecode or w,
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1
;M
;CLASS
\ TYPE10 - EXT.L DO
:CLASS type10 super( machinst )
:M BUILD: { \ work -- }
op1 getOp
get: bytecode -> work
reg: op1 work or -> work
opFmt 1+ 2 max 6 << work or -> work \ set opMode field
work w,
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
1
;M
;CLASS
: ShortImmAdjust \ ( n -- n' )
dup 1 8 inRange?
IF 7 and 9 <<
ELSE 249 asmError
THEN ;
\ TYPE11 - Shift operations e.g. LSL.W #2,D0
:CLASS type11 super( machinst )
:M BUILD: { \ work val -- }
op1 getOp
get: bytecode -> work
mode: op1 11 = mode: op1 0= or
IF
opFmt 6 << work or -> work
op2 getOp
mode: op1 0=
IF
32 work or -> work
reg: op1 9 << work or -> work
ELSE
value: op1 shortImmAdjust ++> work
THEN
reg: op2 work or -> work
work w,
ELSE
192 work or -> work
ea: op1 work or w,
op1 compIdxMode
THEN
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
mode: op1 11 = mode: op1 0= or
IF
op2 getOp
op2 get: dstMask check
1 -> len
ELSE
1 op1 modeSize + -> len
THEN
len
;M
;CLASS
\ TYPE12 - ADDQ, SUBQ
\ e.g. ADDQ.L #4,D6
:CLASS type12 super( machinst )
:M BUILD: { \ work -- }
op1 getOp
op2 getOp
get: bytecode -> work
value: op1 shortImmAdjust ++> work
opFmt 6 << work or -> work
ea: op2 work or -> work
work w,
op2 compIdxMode
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1 op2 modeSize +
;M
;CLASS
\ TYPE13 - ABCD, SBCD
\ e.g. ABCD D1,D2 or ABCD -(A4),-(A3)
:CLASS type13 super( machinst )
:M BUILD: { \ work -- }
op1 getOp
op2 getOp
get: bytecode -> work
reg: op1 work or -> work
reg: op2 9 << work or -> work
mode: op1 0= not
IF
8 ++> work
THEN
work w,
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
mode: op1 mode: op2 = not
IF
207 asmError
THEN
1 -> len
op1 modesize ++> len
op2 modesize ++> len
len
;M
;CLASS